Entrega grupal
¿Qué casas encuestadoras acertaron más y cuáles se desviaron más de los resultados?
# Calcular el porcentaje de error por casa encuestadora
media_errors <- surveys_clean_siglas |>
mutate(anno = year(date_elec)) |>
group_by(anno, Partido, media) |>
summarise(
mean_intention = mean(value, na.rm = TRUE),
.groups = "drop"
) |>
mutate(percentage_intention = mean_intention / sum(mean_intention) * 100) |>
inner_join(votes_percentage, by = c("anno", "Partido" = "siglas")) |>
mutate(error = abs(percentage_votes - percentage_intention))
# Calcular el error promedio por casa encuestadora
accuracy_by_media <- media_errors |>
group_by(media) |>
summarise(
mean_error = mean(error, na.rm = TRUE),
.groups = "drop"
) |>
arrange(mean_error)
# Identificar las casas encuestadoras más acertadas y más desviadas
medios_mas_acertados <- accuracy_by_media |> slice_min(order_by = mean_error, n = 5)
medios_menos_acertados <- accuracy_by_media |> slice_max(order_by = mean_error, n = 5)12.d) Relación entre el censo y el voto mediante un mapa:
indice <- election_data|>
filter(anno==2019) |>
mutate("key"=glue("{codigo_provincia}-{codigo_municipio}")) |>
drop_na(votos_candidaturas, censo) |>
mutate("indice" = votos_candidaturas / censo)
mapa<-mapSpain::esp_get_munic() |>
mutate("key"=glue("{cpro}-{cmun}"))
mapa_indice<- mapa |>
left_join(indice, by="key")
#Grafico de la participacion
g_ind<-ggplot(mapa_indice)+
geom_sf(aes(alpha=indice, fill=indice), color=NA)+
scale_alpha_continuous(range = c(0.7,0.9))+
scale_fill_gradient2(low = "#b9feff",mid="#00c9ff", high = "#040b64", midpoint =
mean(indice$indice), labels = scales::label_number(scale = 100, suffix="%"))+
labs(fill="PARTICIPACION",
title = "PARTICIPACION 2019")+
theme_minimal()+
theme(
axis.text = element_blank(), # Eliminar etiquetas de los ejes
axis.ticks = element_blank(), # Eliminar marcas de los ejes
legend.position = "bottom", # Colocar la leyenda abajo
legend.title = element_text(face = "bold", size = 12), # Estilo de título de la leyenda
legend.text = element_text(size = 8, angle = 30), # Estilo de texto de la leyenda
strip.text = element_text(face = "bold", size = 12), # Estilo de los títulos de las facetas
plot.title = element_text(face = "bold", size = 12, hjust = 0.5), # Estilo del título
plot.subtitle = element_text(size = 12, hjust = 0.5) # Estilo del subtítulo
)+
guides(alpha = "none")
#Grafico del censo de España
g_cen<-ggplot(mapa_indice)+
geom_sf(aes(alpha=censo, fill=censo), color=NA)+
scale_alpha_continuous(range = c(0.7,0.9))+
scale_fill_gradient2(low = "#b9feff",mid="#00c9ff", high = "#040b64", midpoint =
mean(election_data$censo), transform = "log",labels = scales::label_number(scale = 1, accuracy = 1))+
labs(title = "CENSO EN 2019")+
theme_minimal()+
theme(
axis.text = element_blank(), # Eliminar etiquetas de los ejes
axis.ticks = element_blank(), # Eliminar marcas de los ejes
legend.position = "bottom", # Colocar la leyenda abajo
legend.title = element_text(face = "bold", size = 12), # Estilo de título de la leyenda
legend.text = element_text(size = 8, angle = 30), # Estilo de texto de la leyenda
strip.text = element_text(face = "bold", size = 12), # Estilo de los títulos de las facetas
plot.title = element_text(face = "bold", size = 12, hjust = 0.5), # Estilo del título
plot.subtitle = element_text(size = 12, hjust = 0.5) # Estilo del subtítulo
)+
guides(alpha = "none")
votos_censo<-g_ind+g_cen #Sumamos las graficas para compararlas
print(votos_censo) 
ganadores_mun<-election_tidy_with_siglas |>
filter(anno==2019) |>
mutate("key"=glue("{codigo_provincia}-{codigo_municipio}")) |>
group_by(key) |>
drop_na(votos) |>
slice_max(votos)
ganadores_mun<- ganadores_mun|>
mutate("Tipo_mun"= if_else(censo>median(ganadores_mun$censo),"Urbana","Rural"))
ggplot(ganadores_mun)+
geom_bar(aes(x = siglas, fill = siglas))+
scale_fill_manual(values = colores_partidos)+
facet_wrap(~Tipo_mun)+
labs(title = "GANADORES RURALES Y URBANOS 2019",
x= "PARTIDOS",
y= "VICTORIAS")+
theme_minimal()+
theme(
legend.position = "none", # Quitar la leyenda
strip.text = element_text(face = "bold", size = 12), # Estilo de los títulos de las facetas
plot.title = element_text(face = "bold", size = 12, hjust = 0.5), # Estilo del título
plot.subtitle = element_text(size = 12, hjust = 0.5), # Estilo del subtítulo
axis.text = element_text(size = 10, angle = 30)
)+
guides(alpha = "none")
Ejercicios extras
¿Qué 10 partidos obtuvieron mejores resultados en comparación con las predicciones de las encuestas?
comparativa_partidos <- surveys_clean_siglas |>
mutate(anno = year(date_elec)) |>
group_by(anno, Partido) |>
summarise(
mean_intention = mean(value, na.rm = TRUE),
.groups = "drop"
) |>
mutate(percentage_intention = mean_intention / sum(mean_intention) * 100) |>
inner_join(votes_percentage, by = c("anno", "Partido" = "siglas")) |>
mutate(diferencia = percentage_votes - percentage_intention) |>
arrange(desc(diferencia)) |>
slice_max(order_by = diferencia, n = 10)¿Cuál es la relación entre el tamaño del censo y la fragmentación del voto (índice de Herfindahl)? Representar los valores de fragmentación en un mapa por comunidades autonomas.
library(mapSpain)
library(ggplot2)
library(dplyr)
election_tidy_with_siglas <- election_tidy_with_siglas |>
mutate(codigo_ccaa = substr(codigo_ccaa, 1, 2))
fragmentacion_ccaa <- election_tidy_with_siglas |>
group_by(codigo_ccaa, Partido) |>
summarise(votos_totales = sum(votos, na.rm = TRUE), censo_total = sum(censo, na.rm = TRUE), .groups = "drop") |>
group_by(codigo_ccaa) |>
reframe(
indice_herfindahl = sum((votos_totales / sum(votos_totales, na.rm = TRUE))^2, na.rm = TRUE),
censo_total = unique(censo_total)
)
mapa_ccaa <- mapSpain::esp_get_ccaa()
mapa_fragmentacion_ccaa <- mapa_ccaa |>
left_join(fragmentacion_ccaa, by = c("codauto" = "codigo_ccaa"))
ggplot(mapa_fragmentacion_ccaa) +
geom_sf(aes(fill = indice_herfindahl), color = "gray90", size = 0.1) +
geom_sf_text(
data = mapa_fragmentacion_ccaa |> filter(!is.na(indice_herfindahl)),
aes(label = sprintf("%.2f", indice_herfindahl)),
size = 2,
color = "black",
fontface = "bold"
) +
scale_fill_gradientn(
colors = c("lightcoral", "gold", "forestgreen"),
name = "Fragmentación",
limits = c(0, 1),
labels = scales::percent_format(accuracy = 1)
) +
labs(
title = "Fragmentación del Voto por Comunidades Autonomas en España",
subtitle = "Índice de Herfindahl",
fill = "Fragmentación (Herfindahl)"
) +
coord_sf(datum = NA) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
plot.subtitle = element_text(hjust = 0.5, size = 12),
legend.position = "right",
legend.title = element_text(size = 10),
legend.text = element_text(size = 8),
panel.grid = element_blank()
)
# Rodri
crecimiento_partido <- function(election_tidy) {
# Calcular los votos totales por partido y año
votos_agrupados <- election_tidy |>
group_by(anno, Partido) |>
summarise(total_votos = sum(votos, na.rm = TRUE), .groups = "drop")
# Ordenar los datos por partido y año
votos_ordenados <- votos_agrupados |>
arrange(Partido, anno)
# Calcular el crecimiento o disminución porcentual entre elecciones consecutivas
# Usamos lag() para obtener los votos del año anterior
# En las elecciones en las que un determinado partido aparece por primera vez, el cambio
# porcentual es 0
crecimiento <- votos_ordenados |>
group_by(Partido) |>
mutate(cambio_pct = ifelse(is.na(lag(total_votos)), 0, (total_votos - lag(total_votos)) / lag(total_votos) * 100)) |>
ungroup()
return(crecimiento)
}